home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Surface3.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-22  |  12KB  |  376 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSurface3 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Surface3"
  6.    ClientHeight    =   5295
  7.    ClientLeft      =   300
  8.    ClientTop       =   570
  9.    ClientWidth     =   9135
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   5295
  24.    ScaleWidth      =   9135
  25.    Begin VB.CheckBox chkShowData 
  26.       Caption         =   "Show Data"
  27.       Height          =   255
  28.       Left            =   360
  29.       TabIndex        =   15
  30.       Top             =   0
  31.       Width           =   1335
  32.    End
  33.    Begin VB.OptionButton optSurface 
  34.       Caption         =   "Volcano"
  35.       Height          =   255
  36.       Index           =   13
  37.       Left            =   0
  38.       TabIndex        =   14
  39.       Top             =   5040
  40.       Width           =   2055
  41.    End
  42.    Begin VB.OptionButton optSurface 
  43.       Caption         =   "Pit"
  44.       Height          =   255
  45.       Index           =   12
  46.       Left            =   0
  47.       TabIndex        =   13
  48.       Top             =   4680
  49.       Width           =   2055
  50.    End
  51.    Begin VB.OptionButton optSurface 
  52.       Caption         =   "Canyons"
  53.       Height          =   255
  54.       Index           =   11
  55.       Left            =   0
  56.       TabIndex        =   12
  57.       Top             =   4320
  58.       Width           =   2055
  59.    End
  60.    Begin VB.OptionButton optSurface 
  61.       Caption         =   "Hill and Hole"
  62.       Height          =   255
  63.       Index           =   10
  64.       Left            =   0
  65.       TabIndex        =   11
  66.       Top             =   3960
  67.       Width           =   2055
  68.    End
  69.    Begin VB.OptionButton optSurface 
  70.       Caption         =   "Monkey Saddle"
  71.       Height          =   255
  72.       Index           =   9
  73.       Left            =   0
  74.       TabIndex        =   10
  75.       Top             =   3600
  76.       Width           =   2055
  77.    End
  78.    Begin VB.OptionButton optSurface 
  79.       Caption         =   "Splash"
  80.       Height          =   255
  81.       Index           =   0
  82.       Left            =   0
  83.       TabIndex        =   9
  84.       Top             =   360
  85.       Value           =   -1  'True
  86.       Width           =   2055
  87.    End
  88.    Begin VB.OptionButton optSurface 
  89.       Caption         =   "Mounds"
  90.       Height          =   255
  91.       Index           =   1
  92.       Left            =   0
  93.       TabIndex        =   8
  94.       Top             =   720
  95.       Width           =   2055
  96.    End
  97.    Begin VB.OptionButton optSurface 
  98.       Caption         =   "Bowl"
  99.       Height          =   255
  100.       Index           =   2
  101.       Left            =   0
  102.       TabIndex        =   7
  103.       Top             =   1080
  104.       Width           =   2055
  105.    End
  106.    Begin VB.OptionButton optSurface 
  107.       Caption         =   "Ridges"
  108.       Height          =   255
  109.       Index           =   3
  110.       Left            =   0
  111.       TabIndex        =   6
  112.       Top             =   1440
  113.       Width           =   2055
  114.    End
  115.    Begin VB.OptionButton optSurface 
  116.       Caption         =   "Randomized Ridges"
  117.       Height          =   255
  118.       Index           =   4
  119.       Left            =   0
  120.       TabIndex        =   5
  121.       Top             =   1800
  122.       Width           =   2055
  123.    End
  124.    Begin VB.OptionButton optSurface 
  125.       Caption         =   "Hemisphere"
  126.       Height          =   255
  127.       Index           =   5
  128.       Left            =   0
  129.       TabIndex        =   4
  130.       Top             =   2160
  131.       Width           =   2055
  132.    End
  133.    Begin VB.OptionButton optSurface 
  134.       Caption         =   "Holes"
  135.       Height          =   255
  136.       Index           =   6
  137.       Left            =   0
  138.       TabIndex        =   3
  139.       Top             =   2520
  140.       Width           =   2055
  141.    End
  142.    Begin VB.OptionButton optSurface 
  143.       Caption         =   "Cone"
  144.       Height          =   255
  145.       Index           =   7
  146.       Left            =   0
  147.       TabIndex        =   2
  148.       Top             =   2880
  149.       Width           =   2055
  150.    End
  151.    Begin VB.OptionButton optSurface 
  152.       Caption         =   "Saddle"
  153.       Height          =   255
  154.       Index           =   8
  155.       Left            =   0
  156.       TabIndex        =   1
  157.       Top             =   3240
  158.       Width           =   2055
  159.    End
  160.    Begin VB.PictureBox picCanvas 
  161.       AutoRedraw      =   -1  'True
  162.       Height          =   5295
  163.       Left            =   2160
  164.       ScaleHeight     =   349
  165.       ScaleMode       =   3  'Pixel
  166.       ScaleWidth      =   461
  167.       TabIndex        =   0
  168.       Top             =   0
  169.       Width           =   6975
  170.    End
  171. Attribute VB_Name = "frmSurface3"
  172. Attribute VB_GlobalNameSpace = False
  173. Attribute VB_Creatable = False
  174. Attribute VB_PredeclaredId = True
  175. Attribute VB_Exposed = False
  176. Option Explicit
  177. ' Location of viewing eye.
  178. Private EyeR As Single
  179. Private EyeTheta As Single
  180. Private EyePhi As Single
  181. Private Const Dtheta = PI / 20
  182. Private Const Dphi = PI / 20
  183. Private Const Dr = 1
  184. ' Location of focus point.
  185. Private Const FocusX = 0#
  186. Private Const FocusY = 0#
  187. Private Const FocusZ = 0#
  188. Private Projector(1 To 4, 1 To 4) As Single
  189. Private TheGrid As SparseGrid3d
  190. Private Enum SurfaceTypes
  191.     surface_Splash = 0
  192.     surface_Mounds = 1
  193.     surface_Bowl = 2
  194.     surface_Ridges = 3
  195.     surface_RandomRidges = 4
  196.     surface_Hemisphere = 5
  197.     surface_Holes = 6
  198.     surface_Cone = 7
  199.     surface_Saddle = 8
  200.     surface_MonkeySaddle = 9
  201.     surface_HillAndHole = 10
  202.     surface_Canyons = 11
  203.     surface_Pit = 12
  204.     surface_Volcano = 13
  205. End Enum
  206. Private SelectedSurface As SurfaceTypes
  207. Private SphereRadius As Single
  208. Private Const Amplitude1 = 0.25
  209. Private Const Period1 = 2 * PI / 4
  210. Private Const Amplitude2 = 1
  211. Private Const Period2 = 2 * PI / 16
  212. Private Const Amplitude3 = 2
  213. Private Const Xmin = -5
  214. Private Const Zmin = -5
  215. ' Project and display the data.
  216. Private Sub DrawData(pic As Object)
  217. Dim X As Single
  218. Dim Y As Single
  219. Dim Z As Single
  220. Dim S(1 To 4, 1 To 4) As Single
  221. Dim T(1 To 4, 1 To 4) As Single
  222. Dim ST(1 To 4, 1 To 4) As Single
  223. Dim PST(1 To 4, 1 To 4) As Single
  224.     MousePointer = vbHourglass
  225.     DoEvents
  226.     ' Make the data.
  227.     CreateData
  228.     ' Scale and translate so it looks OK in pixels.
  229.     m3Scale S, 35, -35, 1
  230.     m3Translate T, 230, 175, 0
  231.     m3MatMultiplyFull ST, S, T
  232.     m3MatMultiplyFull PST, Projector, ST
  233.     ' Create the grid points.
  234.     TheGrid.InitializeGrid 0.3, 0.3
  235.     ' Transform the points.
  236.     TheGrid.ApplyFull PST
  237.     ' Prevent overflow errors when drawing lines
  238.     ' too far out of bounds.
  239.     On Error Resume Next
  240.     ' Display the data.
  241.     pic.Cls
  242.     TheGrid.Draw pic
  243.     pic.Refresh
  244.     MousePointer = vbDefault
  245.     picCanvas.SetFocus
  246. End Sub
  247. Private Function YValue(ByVal X As Single, ByVal Z As Single)
  248. Dim x1 As Single
  249. Dim z1 As Single
  250. Dim x2 As Single
  251. Dim z2 As Single
  252. Dim D As Single
  253.     Select Case SelectedSurface
  254.         Case surface_Splash
  255.             D = Sqr(X * X + Z * Z)
  256.             YValue = Amplitude1 * Cos(3 * D)
  257.         Case surface_Mounds
  258.             YValue = Amplitude1 * (Cos(Period1 * X) + Cos(Period1 * Z))
  259.         Case surface_Bowl
  260.             YValue = 0.2 * (X * X + Z * Z) - 5#
  261.         Case surface_Ridges
  262.             YValue = Amplitude2 * Cos(Period2 * X) + Amplitude3 * Cos(Period1 * Z) / (Abs(Z) / 3 + 1)
  263.         Case surface_RandomRidges
  264.             YValue = Amplitude2 * Cos(Period2 * X) + Amplitude3 * Cos(Period1 * Z) / (Abs(Z) / 3 + 1) + Amplitude1 * Rnd
  265.         Case surface_Hemisphere
  266.             D = X * X + Z * Z
  267.             If D >= SphereRadius Then
  268.                 YValue = 0
  269.             Else
  270.                 YValue = Sqr(SphereRadius - D)
  271.             End If
  272.         Case surface_Holes
  273.             x1 = (X + Xmin / 2)
  274.             z1 = (Z + Xmin / 2)
  275.             x2 = (X - Xmin / 2)
  276.             z2 = (Z - Xmin / 2)
  277.             YValue = Amplitude3 - _
  278.                 1 / (x1 * x1 + z1 * z1 + 0.1) - _
  279.                 1 / (x2 * x2 + z1 * z1 + 0.1) - _
  280.                 1 / (x1 * x1 + z2 * z2 + 0.1) - _
  281.                 1 / (x2 * x2 + z2 * z2 + 0.1)
  282.         Case surface_Cone
  283.             D = 2 * (Amplitude3 - Sqr(X * X + Z * Z))
  284.             If D < -Amplitude3 Then D = -Amplitude3
  285.             YValue = D
  286.         Case surface_Saddle
  287.             YValue = (X * X - Z * Z) / 10
  288.         Case surface_MonkeySaddle
  289.             x1 = 1.5 * X
  290.             z1 = 1.5 * Z
  291.             YValue = (x1 * x1 * x1 / 3 - x1 * z1 * z1) / 50
  292.         Case surface_HillAndHole
  293.             YValue = -5 * X / (X * X + Z * Z + 1)
  294.         Case surface_Canyons
  295.             YValue = Sin(X * 1.5) * Z * Z * Z / 30
  296.         Case surface_Pit
  297.             YValue = -3 + (X * X + Z * Z) / 10 + Sin(2 * Sqr(X * X + Z * Z)) / 2
  298.         Case surface_Volcano
  299.             YValue = -Abs(X * X + Z * Z - 9) / 10
  300.     End Select
  301. End Function
  302. Private Sub optSurface_Click(Index As Integer)
  303.     SelectedSurface = Index
  304.     DrawData picCanvas
  305. End Sub
  306. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  307.     Select Case KeyCode
  308.         Case vbKeyLeft
  309.             EyeTheta = EyeTheta - Dtheta
  310.         
  311.         Case vbKeyRight
  312.             EyeTheta = EyeTheta + Dtheta
  313.         
  314.         Case vbKeyUp
  315.             EyePhi = EyePhi - Dphi
  316.         
  317.         Case vbKeyDown
  318.             EyePhi = EyePhi + Dphi
  319.                 
  320.         Case Else
  321.             Exit Sub
  322.     End Select
  323.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  324.     DrawData picCanvas
  325. End Sub
  326. Private Sub Form_KeyPress(KeyAscii As Integer)
  327.     Select Case KeyAscii
  328.         Case Asc("+")
  329.             EyeR = EyeR + Dr
  330.         
  331.         Case Asc("-")
  332.             EyeR = EyeR - Dr
  333.         
  334.         Case Else
  335.             Exit Sub
  336.     End Select
  337.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  338.     DrawData picCanvas
  339. End Sub
  340. Private Sub Form_Load()
  341.     ' Initialize the eye position.
  342.     EyeR = 10
  343.     EyeTheta = PI * 0.2
  344.     EyePhi = PI * 0.1
  345.     ' Initialize the projection transformation.
  346.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  347.     ' Project and draw the data.
  348.     Me.Show
  349.     DrawData picCanvas
  350. End Sub
  351. ' Create the surface.
  352. Private Sub CreateData()
  353. Const Xmin = -5
  354. Const Zmin = -5
  355. Const Xmax = -Xmin
  356. Const Zmax = -Zmin
  357. Const Dx = 0.3
  358. Const Dz = 0.3
  359. Const NumX = -2 * Xmin / Dx
  360. Const NumZ = -2 * Zmin / Dz
  361. Const NUM_PTS = NumX * NumZ / 4
  362. Dim i As Integer
  363. Dim X As Single
  364. Dim Y As Single
  365. Dim Z As Single
  366.     SphereRadius = (Xmin + 3 * Dx) * (Xmin + 3 * Dx)
  367.     Set TheGrid = New SparseGrid3d
  368.     For i = 1 To NUM_PTS
  369.         ' Pick a random point in the area.
  370.         X = (Xmax - Xmin) * Rnd + Xmin
  371.         Z = (Zmax - Zmin) * Rnd + Zmin
  372.         Y = YValue(X, Z)
  373.         TheGrid.SetValue X, Y, Z
  374.     Next i
  375. End Sub
  376.